home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / ICONX_FO / FSTRANL.C < prev    next >
Text File  |  1990-03-02  |  11KB  |  469 lines
  1. /*
  2.  * File: fstranl.c
  3.  *  Contents: any, bal, find, many, match, upto
  4.  */
  5.  
  6. #include "::h:config.h"
  7. #include "::h:rt.h"
  8. #include "rproto.h"
  9.  
  10. #ifdef PreProcess
  11. /* include(../M4/fncs.m4) /* */
  12. /* */
  13. #endif                    /* PreProcess */
  14.  
  15. /*
  16.  * any(c,s,i,j) - test if first character of s[i:j] is in c.
  17.  */
  18.  
  19. FncDcl(any,4)
  20.    {
  21.    register word i, j;
  22.    long l1, l2;
  23.    int *cs, csbuf[CsetSize];
  24.    char sbuf[MaxCvtLen];
  25.  
  26.    /*
  27.     * Arg1 must be a cset.  Arg2 defaults to &subject; Arg3 defaults to &pos
  28.     * if Arg2 defaulted, 1 otherwise.  Arg4 defaults to 0.
  29.     */
  30.    if (cvcset(&Arg1, &cs, csbuf) == CvtFail) 
  31.       RunErr(104, &Arg1);
  32.    switch (defstr(&Arg2, sbuf, &k_subject)) {
  33.       case Error:
  34.          RunErr(0, NULL);
  35.       case Defaulted:
  36.          if (defint(&Arg3, &l1, k_pos) == Error) 
  37.             RunErr(0, NULL);
  38.          break;
  39.       default:
  40.          if (defint(&Arg3, &l1, (word)1) == Error) 
  41.             RunErr(0, NULL);
  42.       }
  43.    if (defint(&Arg4, &l2, (word)0) == Error) 
  44.       RunErr(0, NULL);
  45.  
  46.    /*
  47.     * Convert Arg3 and Arg4 to positions in Arg2. If Arg3 == Arg4 then the
  48.     *  specified substring of Arg2 is empty and any fails. Otherwise make
  49.     *  Arg3 the smaller of the two.  (Arg4 is of no further use.)
  50.     */
  51.    i = cvpos(l1, StrLen(Arg2));
  52.    if (i == CvtFail)
  53.       Fail;
  54.    j = cvpos(l2, StrLen(Arg2));
  55.    if (j == CvtFail)
  56.       Fail;
  57.    if (i == j)
  58.       Fail;
  59.    if (i > j)
  60.       i = j;
  61.  
  62.    /*
  63.     * If Arg2[Arg3] is not in the cset Arg1, fail.
  64.     */
  65.    j = (word)StrLoc(Arg2)[i-1];
  66.    if (!Testb(j, cs))
  67.       Fail;
  68.  
  69.    /*
  70.     * Return pos(s[i+1]).
  71.     */
  72.    Arg0.dword = D_Integer;
  73.    IntVal(Arg0) = i + 1;
  74.    Return;
  75.    }
  76.  
  77.  
  78. /*
  79.  * bal(c1,c2,c3,s,i,j) - find end of a balanced substring of s[i:j].
  80.  *  Generates successive positions.
  81.  */
  82.  
  83. FncDcl(bal,6)
  84.    {
  85.    register word i, j;
  86.    register int cnt, c;
  87.    word t;
  88.    long l1, l2;
  89.    int *cs1, *cs2, *cs3;
  90.    int csbuf1[CsetSize], csbuf2[CsetSize], csbuf3[CsetSize];
  91.    char sbuf[MaxCvtLen];
  92.    static int lpar[CsetSize] =    /* '(' */
  93.  
  94. #if !EBCDIC
  95.       cset_display(0, 0, 0400, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  96. #else                    /* !EBCDIC */
  97.       cset_display(0, 0, 0, 0, 0x2000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  98. #endif                    /* !EBCDIC */
  99.  
  100.    static int rpar[CsetSize] =    /* ')' */
  101.  
  102. #if !EBCDIC
  103.       cset_display(0, 0, 01000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  104. #else                    /* !EBCDIC */
  105.       cset_display(0, 0, 0, 0, 0, 0x2000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  106. #endif                    /* !EBCDIC */
  107.  
  108.    /*
  109.     *  Arg1 defaults to &cset; Arg2 defaults to '('; Arg3 defaults to
  110.     *    ')'; Arg4 to &subject; Arg5 to &pos if Arg4 defaulted, 1 otherwise;
  111.     *    Arg6 defaults to 0.
  112.     */
  113.    if ((defcset(&Arg1, &cs1, csbuf1, k_cset.bits) == Error) ||
  114.          (defcset(&Arg2, &cs2, csbuf2, lpar) == Error) ||
  115.          (defcset(&Arg3, &cs3, csbuf3, rpar) == Error)) 
  116.       RunErr(0, NULL);
  117.    switch (defstr(&Arg4, sbuf, &k_subject)) {
  118.       case Error:
  119.          RunErr(0, NULL);
  120.       case Defaulted:
  121.          if (defint(&Arg5, &l1, k_pos) == Error) 
  122.             RunErr(0, NULL);
  123.          break;
  124.       default:
  125.          if (defint(&Arg5, &l1, (word)1) == Error) 
  126.          RunErr(0, NULL);
  127.       }
  128.    if (defint(&Arg6, &l2, (word)0) == Error) 
  129.       RunErr(0, NULL);
  130.  
  131.    /*
  132.     * Convert Arg5 and Arg6 to positions in Arg4 and order them.
  133.     */
  134.    i = cvpos(l1, StrLen(Arg4));
  135.    if (i == CvtFail)
  136.       Fail;
  137.    j = cvpos(l2, StrLen(Arg4));
  138.    if (j == CvtFail)
  139.       Fail;
  140.    if (i > j) {
  141.       t = i;
  142.       i = j;
  143.       j = t;
  144.       }
  145.  
  146.    /*
  147.     * Loop through characters in Arg4[Arg5:Arg6].  When a character in Arg2 is
  148.     *  found, increment cnt; when a character in Arg3 is found, decrement
  149.     *  cnt.  When cnt is 0 there have been an equal number of occurrences
  150.     *  of characters in Arg2 and Arg3, i.e., the string to the left of
  151.     *  i is balanced.  If the string is balanced and the current character
  152.     *  (Arg4[i]) is in Arg1, suspend with i.  Note that if cnt drops below
  153.     *  zero, bal fails.
  154.     */
  155.    cnt = 0;
  156.    Arg0.dword = D_Integer;
  157.    while (i < j) {
  158.       c = StrLoc(Arg4)[i-1];
  159.       if (cnt == 0 && Testb(c, cs1)) {
  160.          IntVal(Arg0) = i;
  161.          Suspend;
  162.          }
  163.       if (Testb(c, cs2))
  164.          cnt++;
  165.       else if (Testb(c, cs3))
  166.          cnt--;
  167.       if (cnt < 0)
  168.          Fail;
  169.       i++;
  170.       }
  171.    /*
  172.     * Eventually fail.
  173.     */
  174.    Fail;
  175.    }
  176.  
  177.  
  178. /*
  179.  * find(s1,s2,i,j) - find string s1 in s2[i:j] and return position in
  180.  *  s2 of beginning of s1.
  181.  * Generates successive positions.
  182.  */
  183.  
  184. FncDcl(find,4)
  185.    {
  186.    register word l;
  187.    register char *s1, *s2;
  188.    word i, j, t;
  189.    long l1, l2;
  190.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  191.  
  192.    /*
  193.     * Arg1 must be a string.  Arg2 defaults to &subject; Arg3 defaults
  194.     *  to &pos if Arg2 is defaulted, or to 1 otherwise; Arg4 defaults
  195.     *  to 0.
  196.  
  197.     */
  198.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  199.       RunErr(103, &Arg1);
  200.    switch (defstr(&Arg2, sbuf2, &k_subject)) {
  201.       case Error:
  202.          RunErr(0, NULL);
  203.       case Defaulted:
  204.          if (defint(&Arg3, &l1, k_pos) == Error) 
  205.             RunErr(0, NULL);
  206.          break;
  207.       default:
  208.          if (defint(&Arg3, &l1, (word)1) == Error) 
  209.             RunErr(0, NULL);
  210.       }
  211.    if (defint(&Arg4, &l2, (word)0)== Error) 
  212.       RunErr(0, NULL);
  213.  
  214.    /*
  215.     * Convert Arg3 and Arg4 to absolute positions in Arg2 and order them.
  216.     */
  217.    i = cvpos(l1, StrLen(Arg2));
  218.    if (i == CvtFail)
  219.       Fail;
  220.    j = cvpos(l2, StrLen(Arg2));
  221.    if (j == CvtFail)
  222.       Fail;
  223.    if (i > j) {
  224.       t = i;
  225.       i = j;
  226.       j = t;
  227.       }
  228.  
  229.    /*
  230.     * Loop through Arg2[i:j] trying to find Arg1 at each point, stopping
  231.     *  when the remaining portion Arg2[i:j] is too short to contain Arg1.
  232.     */
  233.    Arg0.dword = D_Integer;
  234.    while (i <= j - StrLen(Arg1)) {
  235.       s1 = StrLoc(Arg1);
  236.       s2 = StrLoc(Arg2) + i - 1;
  237.       l = StrLen(Arg1);
  238.  
  239.       /*
  240.        * Compare strings on a byte-wise basis; if the end is reached
  241.        *  before inequality is found, suspend with the position of the
  242.        *  string.
  243.        */
  244.       do {
  245.          if (l-- <= 0) {
  246.             IntVal(Arg0) = i;
  247.             Suspend;
  248.             break;
  249.             }
  250.          } while (*s1++ == *s2++);
  251.       i++;
  252.       }
  253.  
  254.    Fail;
  255.    }
  256.  
  257. /*
  258.  * many(c,s,i,j) - find longest prefix of s[i:j] of characters in c.
  259.  */
  260.  
  261. FncDcl(many,4)
  262.    {
  263.    register word i, j, t;
  264.    int *cs, csbuf[CsetSize];
  265.    long l1, l2;
  266.    char sbuf[MaxCvtLen];
  267.  
  268.    /*
  269.     * Arg1 must be a cset.  Arg2 defaults to &subject;    Arg3 defaults to
  270.     *  &pos if Arg2 defaulted, 1 otherwise;  Arg4 defaults to 0.
  271.     */
  272.    if (cvcset(&Arg1, &cs, csbuf) == CvtFail) 
  273.       RunErr(104, &Arg1);
  274.    switch (defstr(&Arg2, sbuf, &k_subject)) {
  275.       case Error:
  276.          RunErr(0, NULL);
  277.       case Defaulted:
  278.          if (defint(&Arg3, &l1, k_pos) == Error) 
  279.             RunErr(0, NULL);
  280.          break;
  281.       default:
  282.          if (defint(&Arg3, &l1, (word)1) == Error) 
  283.             RunErr(0, NULL);
  284.       }
  285.    if (defint(&Arg4, &l2, (word)0) == Error) 
  286.       RunErr(0, NULL);
  287.  
  288.    /*
  289.     * Convert Arg3 and Arg4 to absolute positions and order them.
  290.     */
  291.    i = cvpos(l1, StrLen(Arg2));
  292.    if (i == CvtFail)
  293.       Fail;
  294.    j = cvpos(l2, StrLen(Arg2));
  295.    if (j == CvtFail)
  296.       Fail;
  297.    if (i == j)
  298.       Fail;
  299.    if (i > j) {
  300.       t = i;
  301.       i = j;
  302.       j = t;
  303.       }
  304.  
  305.    /*
  306.     * Fail if first character of Arg2[i:j] is not in Arg1.
  307.     */
  308.    t = (word)StrLoc(Arg2)[i-1];
  309.    if (!Testb(t, cs))
  310.       Fail;
  311.  
  312.    /*
  313.     * Move i along Arg2[i:j] until a character that is not in Arg1 is found or
  314.     *  the end of the string is reached.
  315.     */
  316.    i++;
  317.    while (i < j) {
  318.       t = (word)StrLoc(Arg2)[i-1];
  319.       if (!Testb(t, cs))
  320.          break;
  321.       i++;
  322.       }
  323.  
  324.    /*
  325.     * Return the position of the first character not in Arg1.
  326.     */
  327.    Arg0.dword = D_Integer;
  328.    IntVal(Arg0) = i;
  329.    Return;
  330.    }
  331.  
  332. /*
  333.  * match(s1,s2,i,j) - test if s1 is prefix of s2[i:j].
  334.  */
  335. FncDcl(match,4)
  336.    {
  337.    register word i;
  338.    register char *s1, *s2;
  339.    word j, t;
  340.    long l1, l2;
  341.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  342.  
  343.    /*
  344.     * Arg1 must be a string.  Arg2 defaults to &subject;  Arg3 defaults
  345.     *  to &pos if Arg2 defaulted, 1 otherwise; Arg4 defaults to 0.
  346.     */
  347.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  348.       RunErr(103, &Arg1);
  349.    switch (defstr(&Arg2, sbuf2, &k_subject)) {
  350.       case Error:
  351.          RunErr(0, NULL);
  352.       case Defaulted:
  353.          if (defint(&Arg3, &l1, k_pos) == Error) 
  354.             RunErr(0, NULL);
  355.          break;
  356.       default:
  357.          if (defint(&Arg3, &l1, (word)1) == Error) 
  358.             RunErr(0, NULL);
  359.       }
  360.    if (defint(&Arg4, &l2, (word)0) == Error) 
  361.       RunErr(0, NULL);
  362.  
  363.    /*
  364.     * Convert Arg3 and Arg4 to absolute positions and order them.
  365.     */
  366.    i = cvpos(l1, StrLen(Arg2));
  367.    if (i == CvtFail)
  368.       Fail;
  369.    j = cvpos(l2, StrLen(Arg2));
  370.    if (j == CvtFail)
  371.       Fail;
  372.    if (i > j) {
  373.       t = i;
  374.       i = j;
  375.       j = t - j;
  376.       }
  377.    else
  378.       j = j - i;
  379.  
  380.    /*
  381.     * Cannot match unless Arg1 is as long as Arg2[i:j].
  382.     */
  383.    if (j < StrLen(Arg1))
  384.       Fail;
  385.  
  386.    /*
  387.     * Compare Arg1 with Arg2[i:j] for *Arg1 characters; fail if an inequality
  388.     *  if found.
  389.     */
  390.    s1 = StrLoc(Arg1);
  391.    s2 = StrLoc(Arg2) + i - 1;
  392.    for (j = StrLen(Arg1); j > 0; j--)
  393.       if (*s1++ != *s2++)
  394.          Fail;
  395.  
  396.    /*
  397.     * Return position of end of matched string in Arg2.
  398.     */
  399.    Arg0.dword = D_Integer;
  400.    IntVal(Arg0) = i + StrLen(Arg1);
  401.    Return;
  402.    }
  403.  
  404. /*
  405.  * upto(c,s,i,j) - find each occurrence in s[i:j] of a character in c.
  406.  * Generates successive positions.
  407.  */
  408.  
  409. FncDcl(upto,4)
  410.    {
  411.    register word i, j, t;
  412.    long l1, l2;
  413.    int *cs, csbuf[CsetSize];
  414.    char sbuf[MaxCvtLen];
  415.  
  416.    /*
  417.     * Arg1 must be a cset.  Arg2 defaults to &subject; Arg3 defaults
  418.     *  to &pos if Arg2 defaulted, 1 otherwise; Arg4 defaults to 0.
  419.     */
  420.    if (cvcset(&Arg1, &cs, csbuf) == CvtFail) 
  421.       RunErr(104, &Arg1);
  422.    switch (defstr(&Arg2, sbuf, &k_subject)) {
  423.       case Error:
  424.          RunErr(0, NULL);
  425.       case Defaulted:
  426.          if (defint(&Arg3, &l1, k_pos) == Error) 
  427.             RunErr(0, NULL);
  428.          break;
  429.       default:
  430.          if (defint(&Arg3, &l1, (word)1) == Error) 
  431.             RunErr(0, NULL);
  432.       }
  433.    if (defint(&Arg4, &l2, (word)0) == Error)
  434.       RunErr(0, NULL);
  435.  
  436.    /*
  437.     * Convert Arg3 and Arg4 to positions in Arg2 and order them.
  438.     */
  439.    i = cvpos(l1, StrLen(Arg2));
  440.    if (i == CvtFail)
  441.       Fail;
  442.    j = cvpos(l2, StrLen(Arg2));
  443.    if (j == CvtFail)
  444.       Fail;
  445.    if (i > j) {
  446.       t = i;
  447.       i = j;
  448.       j = t;
  449.       }
  450.  
  451.    /*
  452.     * Look through Arg2[i:j] and suspend position of each occurrence of
  453.     *  of a character in Arg1.
  454.     */
  455.    while (i < j) {
  456.       t = (word)StrLoc(Arg2)[i-1];
  457.       if (Testb(t, cs)) {
  458.          Arg0.dword = D_Integer;
  459.          IntVal(Arg0) = i;
  460.          Suspend;
  461.          }
  462.       i++;
  463.       }
  464.    /*
  465.     * Eventually fail.
  466.     */
  467.    Fail;
  468.    }
  469.